home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / contro2r / form4.frm < prev    next >
Text File  |  1999-04-06  |  6KB  |  232 lines
  1. VERSION 5.00
  2. Begin VB.Form Form4 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Scan File"
  5.    ClientHeight    =   2640
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6855
  9.    LinkTopic       =   "Form4"
  10.    MaxButton       =   0   'False
  11.    ScaleHeight     =   2640
  12.    ScaleWidth      =   6855
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.CommandButton seek 
  15.       BackColor       =   &H00C0C0C0&
  16.       Caption         =   "&Seek"
  17.       BeginProperty Font 
  18.          Name            =   "Times New Roman"
  19.          Size            =   8.25
  20.          Charset         =   0
  21.          Weight          =   400
  22.          Underline       =   0   'False
  23.          Italic          =   0   'False
  24.          Strikethrough   =   0   'False
  25.       EndProperty
  26.       Height          =   735
  27.       Left            =   5880
  28.       Picture         =   "Form4.frx":0000
  29.       Style           =   1  'Graphical
  30.       TabIndex        =   9
  31.       ToolTipText     =   "Seek For *ico and load it"
  32.       Top             =   960
  33.       Width           =   855
  34.    End
  35.    Begin VB.CommandButton load 
  36.       Caption         =   "&Load"
  37.       BeginProperty Font 
  38.          Name            =   "Times New Roman"
  39.          Size            =   8.25
  40.          Charset         =   0
  41.          Weight          =   400
  42.          Underline       =   0   'False
  43.          Italic          =   0   'False
  44.          Strikethrough   =   0   'False
  45.       EndProperty
  46.       Height          =   735
  47.       Left            =   5880
  48.       Picture         =   "Form4.frx":0442
  49.       Style           =   1  'Graphical
  50.       TabIndex        =   8
  51.       ToolTipText     =   "Load Record Into Database"
  52.       Top             =   1800
  53.       Width           =   855
  54.    End
  55.    Begin VB.ListBox List2 
  56.       Height          =   2010
  57.       Left            =   3960
  58.       TabIndex        =   5
  59.       Top             =   360
  60.       Width           =   1815
  61.    End
  62.    Begin VB.FileListBox File1 
  63.       Height          =   1650
  64.       Left            =   -1320
  65.       MultiSelect     =   2  'Extended
  66.       Pattern         =   "*.ico"
  67.       TabIndex        =   4
  68.       Top             =   -1200
  69.       Visible         =   0   'False
  70.       Width           =   1815
  71.    End
  72.    Begin VB.CommandButton Command1 
  73.       Caption         =   "&Scan"
  74.       Height          =   735
  75.       Left            =   5880
  76.       Picture         =   "Form4.frx":0884
  77.       Style           =   1  'Graphical
  78.       TabIndex        =   3
  79.       Top             =   120
  80.       Width           =   855
  81.    End
  82.    Begin VB.ListBox List1 
  83.       Height          =   2010
  84.       Left            =   2040
  85.       TabIndex        =   2
  86.       Top             =   360
  87.       Width           =   1815
  88.    End
  89.    Begin VB.DirListBox Dir1 
  90.       Height          =   1890
  91.       Left            =   120
  92.       TabIndex        =   1
  93.       Top             =   480
  94.       Width           =   1815
  95.    End
  96.    Begin VB.DriveListBox Drive1 
  97.       Height          =   315
  98.       Left            =   120
  99.       TabIndex        =   0
  100.       Top             =   120
  101.       Width           =   1815
  102.    End
  103.    Begin VB.Label Label2 
  104.       Caption         =   "Pathname"
  105.       Height          =   255
  106.       Left            =   3960
  107.       TabIndex        =   7
  108.       Top             =   120
  109.       Width           =   1815
  110.    End
  111.    Begin VB.Label Label1 
  112.       Caption         =   "Filename"
  113.       Height          =   255
  114.       Left            =   2040
  115.       TabIndex        =   6
  116.       Top             =   120
  117.       Width           =   1815
  118.    End
  119. End
  120. Attribute VB_Name = "Form4"
  121. Attribute VB_GlobalNameSpace = False
  122. Attribute VB_Creatable = False
  123. Attribute VB_PredeclaredId = True
  124. Attribute VB_Exposed = False
  125. Dim InitialFolder
  126. Dim totalFiles As Integer
  127. Private Sub Drive1_Change()
  128.     drvc2
  129. End Sub
  130.  
  131. Private Sub Command1_Click()
  132. On Error GoTo pathac
  133. totalFiles = 0
  134. List1.clear
  135. List2.clear
  136.     ChDrive Drive1.Drive
  137.     ChDir Dir1.Path
  138.     InitialFolder = CurDir
  139.     Me.MousePointer = 11
  140.     ScanFolders
  141.     Me.MousePointer = 0
  142.     MsgBox "There are " & totalFiles & " under the " & InitialFolder & " folder", vbInformation, "dyr_workshop"
  143. Exit Sub
  144. pathac:
  145.     MsgBox "There's Some Path Access Errorr"
  146.     Exit Sub
  147. End Sub
  148.  
  149. Sub ScanFolders()
  150. Dim subFolders As Integer
  151. Dim i As Integer
  152.     For i = 0 To File1.ListCount - 1
  153.         File1.Selected(i) = True
  154.         List1.AddItem File1.filename
  155.         List2.AddItem File1.Path
  156.     Next i
  157.     totalFiles = totalFiles + File1.ListCount
  158.     subFolders = Dir1.ListCount
  159.     If subFolders > 0 Then
  160.         For i = 0 To subFolders - 1
  161.             ChDir Dir1.List(i)
  162.             Dir1.Path = Dir1.List(i)
  163.             File1.Path = Dir1.List(i)
  164.             Form1.Refresh
  165.             ScanFolders
  166.         Next
  167.     End If
  168.     File1.Path = Dir1.Path
  169.     MoveUp
  170. End Sub
  171.  
  172. Sub MoveUp()
  173.     If Dir1.List(-1) <> InitialFolder Then
  174.         ChDir Dir1.List(-2)
  175.         Dir1.Path = Dir1.List(-2)
  176.     End If
  177. End Sub
  178.  
  179. Private Sub Dir1_Change()
  180.     ChDir Dir1.Path
  181.     File1.Path = Dir1.Path
  182. End Sub
  183.  
  184. Private Sub Form_Load()
  185.     ChDrive App.Path
  186.     ChDir App.Path
  187. End Sub
  188.  
  189. Private Sub List1_Click()
  190.     List2.ListIndex = List1.ListIndex
  191. End Sub
  192.  
  193. Private Sub List2_Click()
  194.     List1.ListIndex = List2.ListIndex
  195. End Sub
  196.  
  197. Private Sub load_Click()
  198. Dim i As Integer
  199. For i = 0 To List1.ListCount - 1
  200.     If List1.Selected(i) Then
  201.         Form1.Data1.Recordset.AddNew
  202.         Form1.Text1.Text = List1.List(i)
  203.         Form1.Text2.Text = List2.List(i)
  204.     If Right(List1.Text, 1) = "\" Then
  205.         Form1.Image1.Picture = LoadPicture(Form1.Text2.Text & Form1.Text1.Text)
  206.     Else
  207.         Form1.Image1.Picture = LoadPicture(Form1.Text2.Text & "\" & Form1.Text1.Text)
  208.     End If
  209.     Form1.Image1.Refresh
  210.     Form1.Data1.Recordset.Update
  211.     Form1.Data1.Recordset.MoveLast
  212.     End If
  213. Next i
  214. End Sub
  215.  
  216. Private Sub seek_Click()
  217.     On Error GoTo xyz
  218.     Me.MousePointer = 11
  219.     Dim i As Integer
  220.     For i = 0 To List1.ListCount - 1
  221.         List1.Selected(i) = True
  222.         load_Click
  223.     Next i
  224.     
  225.     Me.MousePointer = 0
  226.     MsgBox i & " Records Are Added", vbInformation, "dyr_workshop"
  227. Exit Sub
  228. xyz:
  229.     MsgBox "There's Nothing To Select", vbCritical, "dyr_workshop"
  230. Exit Sub
  231. End Sub
  232.